Over 1,000 Windows 95 Programs/Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso/0361/alltheti.frm

Text File | 1997-03-31 | 20KB | 697 lines

VERSION 2.00
Begin Form AllTheTime
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   0  'None
   Caption         =   "AllTheTime"
   ClientHeight    =   30
   ClientLeft      =   60
   ClientTop       =   330
   ClientWidth     =   810
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   FillColor       =   &H00C0C0C0&
   FillStyle       =   0  'Solid
   FontBold        =   0   'False
   FontItalic      =   0   'False
   FontName        =   "MS Sans Serif"
   FontSize        =   8.25
   FontStrikethru  =   0   'False
   FontUnderline   =   0   'False
   Height          =   465
   Icon            =   ALLTHETI.FRX:0000
   Left            =   -15
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   30
   ScaleWidth      =   810
   Top             =   -30
   Visible         =   0   'False
   Width           =   960
   Begin TextBox Text1
      Height          =   288
      Left            =   2016
      LinkTimeout     =   -1
      TabIndex        =   5
      Top             =   624
      Visible         =   0   'False
      Width           =   372
   End
   Begin PictureClip MoonSun
      Cols            =   5
      Location        =   "1200,2400,2250,5430"
      Picture         =   ALLTHETI.FRX:0302
      Rows            =   10
   End
   Begin SSFrame Frame3D1
      ForeColor       =   &H00000000&
      Height          =   195
      Left            =   15
      TabIndex        =   4
      Top             =   8160
      Width           =   135
      Begin SSOption Option3D1
         Alignment       =   1  'Right Justify
         Caption         =   "&3 - Bottom right"
         ForeColor       =   &H00000000&
         Height          =   255
         Index           =   2
         Left            =   1920
         TabIndex        =   2
         Top             =   960
         Value           =   -1  'True
         Width           =   1575
      End
      Begin SSOption Option3D1
         Caption         =   "&5 - Elsewhere"
         ForeColor       =   &H00000000&
         Height          =   255
         Index           =   4
         Left            =   1530
         TabIndex        =   6
         TabStop         =   0   'False
         Top             =   615
         Width           =   1575
      End
      Begin SSOption Option3D1
         Caption         =   "&1 - Upper left"
         ForeColor       =   &H00000000&
         Height          =   255
         Index           =   0
         Left            =   105
         TabIndex        =   0
         TabStop         =   0   'False
         Top             =   255
         Width           =   1455
      End
      Begin SSOption Option3D1
         Alignment       =   1  'Right Justify
         Caption         =   "&2 - Upper right"
         ForeColor       =   &H00000000&
         Height          =   255
         Index           =   1
         Left            =   1920
         TabIndex        =   1
         TabStop         =   0   'False
         Top             =   270
         Width           =   1575
      End
      Begin SSOption Option3D1
         Caption         =   "&4 - Bottom left"
         ForeColor       =   &H00000000&
         Height          =   255
         Index           =   3
         Left            =   120
         TabIndex        =   3
         TabStop         =   0   'False
         Top             =   960
         Width           =   1575
      End
   End
   Begin Image Delta
      Height          =   195
      Left            =   795
      Top             =   30
      Width           =   195
   End
   Begin Image StopWatch
      Height          =   195
      Left            =   570
      Top             =   30
      Width           =   195
   End
   Begin Image PrtStatus
      Height          =   240
      Left            =   510
      Top             =   10005
      Width           =   300
   End
   Begin Image PrtInactive
      Height          =   240
      Left            =   510
      Top             =   10080
      Width           =   285
   End
   Begin Image PrtActive
      Height          =   240
      Left            =   510
      Top             =   10080
      Width           =   300
   End
   Begin Image Picture1
      Height          =   225
      Left            =   30
      Top             =   30
      Width           =   240
   End
   Begin Image MoonPic
      Height          =   192
      Left            =   300
      Top             =   30
      Width           =   192
   End
   Begin Image SeasonPic
      Height          =   192
      Left            =   4080
      Top             =   30
      Width           =   192
   End
End
'DefInt A-Z
Const GroupFauxCompilerDirective = False

Sub Delta_Click ()
SoundABorted = True
End Sub

Sub Delta_DblClick ()
SoundABorted = True
'DblCFlag% = True

End Sub

Sub Delta_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Delta.Picture = MoonSun.GraphicCell(46)
Call Form_MouseDown(Button, Shift, X, Y)
If Button = 1 Then 'Left button
   If gDeltaRunning = 2 Then
      'start timer
      gResUser = GetFreeSystemResources(2) - (gStoppedResUser - gResUser)
      gResGDI = GetFreeSystemResources(1) - (gStoppedResGDI - gResGDI)
      gRes = GetFreeSystemResources(0) - (gStoppedRes - gRes)
      gTotMem = GetTotalMem() - (gStoppedTotMem - gTotMem)
      gBlkMem = GetBlockMem() - (gStoppedBlkMem - gBlkMem)
      Delta.Picture = MoonSun.GraphicCell(47)
      LastTime& = 0
      'FontChangedNotYetSized = True
      gDeltaRunning = 1
   Else
      'stop timer
      gStoppedResUser = GetFreeSystemResources(2)
      gStoppedResGDI = GetFreeSystemResources(1)
      gStoppedRes = GetFreeSystemResources(0)
      gStoppedTotMem = GetTotalMem()
      gStoppedBlkMem = GetBlockMem()
      LastTime& = 0
      Delta.Picture = MoonSun.GraphicCell(48)
      gDeltaRunning = 2
   End If
End If
If Button = 2 Then
      gResUser = GetFreeSystemResources(2)
      gResGDI = GetFreeSystemResources(1)
      gRes = GetFreeSystemResources(0)
      gTotMem = GetTotalMem()
      gBlkMem = GetBlockMem()
      gStoppedResUser = GetFreeSystemResources(2)
      gStoppedResGDI = GetFreeSystemResources(1)
      gStoppedRes = GetFreeSystemResources(0)
      gStoppedTotMem = GetTotalMem()
      gStoppedBlkMem = GetBlockMem()
      LastTime& = 0
End If


Exit Sub

If (gDeltaRunning = 0) Or (gDeltaRunning = 2 And Button = 2) Then
   If (gDeltaRunning = 0) Then
      gResUser = GetFreeSystemResources(2)
      gResGDI = GetFreeSystemResources(1)
      gRes = GetFreeSystemResources(0)
      gTotMem = GetTotalMem()
      gBlkMem = GetBlockMem()
   Else
      gResUser = GetFreeSystemResources(2) - (gStoppedResUser - gResUser)
      gResGDI = GetFreeSystemResources(1) - (gStoppedResGDI - gResGDI)
      gRes = GetFreeSystemResources(0) - (gStoppedRes - gRes)
      gTotMem = GetTotalMem() - (gStoppedTotMem - gTotMem)
      gBlkMem = GetBlockMem() - (gStoppedBlkMem - gBlkMem)
   End If
   gDeltaRunning = 1
   Delta.Picture = MoonSun.GraphicCell(47)
   LastTime& = 0
Else
   If gDeltaRunning = 1 Then
      gDeltaRunning = 2
      gStoppedResUser = GetFreeSystemResources(2)
      gStoppedResGDI = GetFreeSystemResources(1)
      gStoppedRes = GetFreeSystemResources(0)
      gStoppedTotMem = GetTotalMem()
      gStoppedBlkMem = GetBlockMem()
      LastTime& = 0
      Delta.Picture = MoonSun.GraphicCell(48)
   Else
      Delta.Picture = MoonSun.GraphicCell(45)
      gDeltaRunning = 0
      gResUser = 0
      gResGDI = 0
      gRes = 0
      gTotMem = 0
      gBlkMem = 0
      LastTime& = 0
   End If
End If


End Sub

Sub Delta_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseMove(Button, Shift, X, Y)
End Sub

Sub Delta_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseUp(Button, Shift, X, Y)
End Sub

Sub Form_Activate ()
    'MsgBox ("Activate...")
      If AllTheTime.Left >= Screen.Width - 15 Then
         AllTheTime.Left = AllTheTime.Tag
      End If
End Sub

'
'
Sub Form_Click ()
SoundABorted = True
CFlag% = True
End Sub

Sub Form_DblClick ()
DblCFlag% = True
End Sub

Sub Form_GotFocus ()
      If AllTheTime.Left >= Screen.Width - 15 Then
         AllTheTime.Left = AllTheTime.Tag
      End If
'
'Settings.SetFocus
End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case Alt_R      'Rotate
            For I% = 0 To 4
            If gOption3D1(I%) Then S% = I%
            Next I%
            gOption3D1((S% + 1) Mod 5) = True
            gOption3D1(S%) = False
            KeyCode = 0
            Shift = 0
            Call PositionATT

        Case Alt_T      'Turn off
'            KeyCode = 0
'            Shift = 0
'            AllTheTime.Visible = Not AllTheTime.Visible
   End Select

End Sub

Sub Form_KeyPress (KeyAscii As Integer)
    If KeyAscii = Asc("X") Then
       'DeleteMenus
       FinalProcessing
       End 'Program
    End If
End Sub

Sub Form_Load ()
If hSubMenus <> 0 Then
   MsgBox "Loading twice..."
   End
End If

SeasonDescArr$(0) = "Fall"
SeasonDescArr$(1) = "Winter"
SeasonDescArr$(2) = "Spring"
SeasonDescArr$(3) = "Summer"
MoonDescArr$(0) = "Full moon"
MoonDescArr$(1) = "Waning, full moon"
MoonDescArr$(2) = "Third quarter"
MoonDescArr$(3) = "Waning, third quarter"
MoonDescArr$(4) = "New moon"
MoonDescArr$(5) = "Waxing, new moon"
MoonDescArr$(6) = "First quarter"
MoonDescArr$(7) = "Waxing, first quarter"
TODDescArr$(0) = "morning"
TODDescArr$(1) = "afternoon"
TODDescArr$(2) = "evening"
TODDescArr$(3) = "night"


If GroupFauxCompilerDirective Then
   Text1.LinkMode = 0
   Text1.LinkTopic = "Progman|Progman"
   Text1.LinkItem = "Groups"
   Text1.LinkMode = 2
   Text1.LinkRequest

   hGroupMenu = CreatePopUpMenu()
   T% = AppendMenu(hMainMenu, MF_SEPARATOR, IDM_ITEMS, "-")

   Groups$ = Text1.Text
   While Groups$ <> ""
      cPos = InStr(Groups$, Chr(13))
      OneGroup$ = Left$(Groups$, cPos - 1)
      Groups$ = Mid$(Groups$, cPos + 2, 30000)
      hSubMenus = hSubMenus + 1
      ReDim Preserve hSubMenu(hSubMenus)
      hSubMenu(hSubMenus) = CreatePopUpMenu()   'popup

      Text1.LinkItem = OneGroup$
      Text1.LinkMode = 2
      Text1.LinkRequest

      Progs$ = Text1.Text
      FirstOne = True
      While Progs$ <> ""
         cPos = InStr(Progs$, Chr(13))
         OneProg$ = Left$(Progs$, cPos - 1)
         Progs$ = Mid$(Progs$, cPos + 2, 30000)
         PName$ = Mid$(OneProg$, 2, 30000)
         PName$ = Mid$(PName$, 1, InStr(PName$, Chr(34)) - 1)
         If FirstOne Then
            FirstOne = False
         Else
            T% = AppendMenu(hSubMenu(hSubMenus), MF_STRING, IDM_ITEMS + hSubMenus, PName$)
         End If
      Wend

      T% = AppendMenu(hGroupMenu, MF_POPUP, hSubMenu(hSubMenus), OneGroup$)
   Wend

T% = AppendMenu(hMainMenu, MF_POPUP, hGroupMenu, "Groups...")
End If

PrtActive.Picture = MoonSun.GraphicCell(20)
PrtInActive.Picture = MoonSun.GraphicCell(21)
PrtStatus.Picture = MoonSun.GraphicCell(21)
StopWatch.Picture = MoonSun.GraphicCell(30)
Delta.Picture = MoonSun.GraphicCell(47)
Picture1.Picture = MoonSun.GraphicCell(23)
End Sub

Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
MStartX = X
MStartY = Y
StartLeft = Left
StartTop = Top
AllowFormToMove = True
Moved = True
If Shift <> 1 Then
   'AutoRedraw = False   '1/15
Else
   'Beep
End If
End Sub

Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
If AllowFormToMove = True Then
        AllTheTime.Left = AllTheTime.Left + (X - MStartX)
        AllTheTime.Top = AllTheTime.Top + (Y - MStartY)
End If

End Sub

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)

AllowFormToMove = False
'AutoRedraw = True '1/15
If Left = StartLeft And Top = StartTop Then
   Moved = False
Else
   PosLeft = AllTheTime.Left
   PosTop = AllTheTime.Top
   gOption3D1(4) = True
   For I% = 0 To 3
      gOption3D1(I%) = False
   Next I%
   Call PositionATT
End If
End Sub

Sub Form_Paint ()
'
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 3 Then
   'DeleteMenus
   FinalProcessing
   End 'Program
End If
End Sub

Sub Form_Resize ()
'SavedVis = Visible
'Visible = False
If Resizing Then Exit Sub
Resizing = True
If WindowState = 1 Then
   Exit Sub
End If
Call SetTime
Call SetSize
Call PositionATT
'Visible = SavedVis
Resizing = False
End Sub

Sub MoonPic_DblClick ()
SoundABorted = True
MoonList.Show 1
End Sub

Sub MoonPic_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Call Form_MouseDown(Button, Shift, X, Y)
'Form1.Label1.FontName = AllTheTime.FontName
'Form1.Label1.ForeColor = AllTheTime.ForeColor
'If Form1.Label1.ForeColor = Form1.Label1.BackColor Then
'   Form1.Label1.BackColor = AllTheTime.BackColor
'End If
'Form1.Label1.FontSize = AllTheTime.FontSize
'Form1.Label1.FontBold = AllTheTime.FontBold
'Form1.Label1.FontItalic = AllTheTime.FontItalic
Form1.Label1.AutoSize = True
If gMoonExact% Then gWaxDesc$ = ""
Form1.Label1.Caption = " " + (gWaxDesc$) + MoonDesc$ + " " + SavedDat$ + " "
Form1.Label1.AutoSize = False
Form1.Label1.Width = Form1.Label1.Width + 60
Form1.Label1.Height = Form1.Label1.Height + 30
Form1.Width = Form1.Label1.Width
Form1.Height = Form1.Label1.Height
Form1.Label1.Left = 0
Form1.Label1.Top = 0
Form1.Top = AllTheTime.Top + Y - Form1.Height
Form1.Left = AllTheTime.Left + MoonPic.Left + X
If Form1.Top < 0 Then Form1.Top = 0
If Form1.Left + Form1.Width > Screen.Width Then Form1.Left = Screen.Width - Form1.Width

'Form1.ZOrder 0
Form1.Show
wOn_Top% = SetWindowPos(Form1.hWnd, -1, 0, 0, 0, 0, wFlags = &H2 Or &H1 Or &H40 Or &H10)
End Sub

Sub MoonPic_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseMove(Button, Shift, X, Y)

End Sub

Sub MoonPic_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Call Form_MouseUp(Button, Shift, X, Y)
Unload Form1

End Sub

Sub Option3D1_Click (Index As Integer, Value As Integer)
If gPositioning Then Exit Sub
For I% = 0 To 4: gOption3D1(I%) = 0: Next I%
gOption3D1(Index) = Value
Call PositionATT

End Sub

Sub Picture1_DblClick ()
Call PictureMenuMouseDown(0, 0, 0, 0)
SoundABorted = True
'DblCFlag% = True
End Sub

Sub Picture1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call PictureMenuMouseDown(Button, Shift, X, Y)
End Sub

Sub PrtActive_Click ()
SoundABorted = True
End Sub

Sub PrtActive_DblClick ()
'On Local Error Resume Next
T% = Shell("PRINTMAN", 1)
'AppActivate "Print Manager"
'hActive% = GetActiveWindow()                 ' pickup it's hWnd handle
'Call SwitchToThisWindow(hActive%, True)
'On Local Error GoTo 0
End Sub

Sub PrtActive_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseDown(Button, Shift, X, Y)
End Sub

Sub PrtActive_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseMove(Button, Shift, X, Y)
End Sub

Sub PrtActive_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseUp(Button, Shift, X, Y)
End Sub

Sub PrtInactive_Click ()
SoundABorted = True
End Sub

Sub PrtInactive_DblClick ()
T% = Shell("PRINTMAN", 1)

End Sub

Sub PrtInactive_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseDown(Button, Shift, X, Y)
PrtInActive.Picture = MoonSun.GraphicCell(20)
End Sub

Sub PrtInactive_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseMove(Button, Shift, X, Y)
End Sub

Sub PrtInactive_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseUp(Button, Shift, X, Y)
PrtInActive.Picture = MoonSun.GraphicCell(21)
End Sub

Sub SeasonPic_Click ()
SoundABorted = True
End Sub

Sub SeasonPic_DblClick ()
SoundABorted = True
'DblCFlag% = True
End Sub

Sub SeasonPic_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Call Form_MouseDown(Button, Shift, x, Y)
'Form1.Label1.FontName = AllTheTime.FontName
'Form1.Label1.ForeColor = AllTheTime.ForeColor
'If Form1.Label1.ForeColor = Form1.Label1.BackColor Then
'   Form1.Label1.BackColor = AllTheTime.BackColor
'End If
'Form1.Label1.FontSize = AllTheTime.FontSize
'Form1.Label1.FontBold = AllTheTime.FontBold
'Form1.Label1.FontItalic = AllTheTime.FontItalic

Form1.Label1.AutoSize = True
Form1.Label1.Caption = " " + SeasonDesc$ + " " + TODDesc$ + " "
Form1.Label1.AutoSize = False
Form1.Label1.Width = Form1.Label1.Width + 60
Form1.Label1.Height = Form1.Label1.Height + 30
Form1.Width = Form1.Label1.Width
Form1.Height = Form1.Label1.Height
Form1.Label1.Left = 0
Form1.Label1.Top = 0

Form1.Top = AllTheTime.Top + Y - Form1.Height
Form1.Left = AllTheTime.Left + SeasonPic.Left + X - Form1.Label1.Width
'Form1.ZOrder 0
If Form1.Top < 0 Then Form1.Top = 0
If Form1.Left + Form1.Width > Screen.Width Then Form1.Left = Screen.Width - Form1.Width
Form1.Show
wOn_Top% = SetWindowPos(Form1.hWnd, -1, 0, 0, 0, 0, wFlags = &H2 Or &H1 Or &H40 Or &H10)

End Sub

Sub SeasonPic_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseMove(Button, Shift, X, Y)
End Sub

Sub SeasonPic_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Call Form_MouseUp(Button, Shift, x, Y)
Unload Form1

End Sub

Sub StopWatch_Click ()
SoundABorted = True
End Sub

Sub StopWatch_DblClick ()
SoundABorted = True
'DblCFlag% = True
End Sub

Sub StopWatch_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseDown(Button, Shift, X, Y)
If Button = 1 Then 'Left button
   If gTimerRunning = 2 Then
      'start timer
      gTime = Time - (gStoppedTime - gTime)
      StopWatch.Picture = MoonSun.GraphicCell(30)
      LastTime& = 0
      'FontChangedNotYetSized = True
      gTimerRunning = 1
   Else
      'stop timer
      gStoppedTime = Time
      LastTime& = 0
      StopWatch.Picture = MoonSun.GraphicCell(25)
      gTimerRunning = 2
   End If
End If
If Button = 2 Then
      gTime = Time
      gStoppedTime = Time
      LastTime& = 0
End If

Exit Sub

If (gTimerRunning = 0) Or (gTimerRunning = 2 And Button = 2) Then
   If (gTimerRunning = 0) Then
      gTime = Time
   Else
      gTime = Time - (gStoppedTime - gTime)
   End If
   gTimerRunning = 1
   StopWatch.Picture = MoonSun.GraphicCell(26)
   gStopPic = 0
   LastTime& = 0
Else
   If gTimerRunning = 1 Then
      gTimerRunning = 2
      gStoppedTime = Time
      LastTime& = 0
      StopWatch.Picture = MoonSun.GraphicCell(25)
   Else
      StopWatch.Picture = MoonSun.GraphicCell(24)
      gTimerRunning = 1 'was 0
      gTime = 0
      LastTime& = 0
      FontChangedNotYetSized = True
   End If
End If
End Sub

Sub StopWatch_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseMove(Button, Shift, X, Y)

End Sub

Sub StopWatch_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Form_MouseUp(Button, Shift, X, Y)

End Sub